Informática Multimedia 1995 April/Informatica Multimedia CD - Epimundo.iso/DOS/CAT_DISK/VLITE.ZIP/VISAGE.PAS

Pascal/Delphi Source File | 1992-04-09 | 14.4 KB | 570 lines

{
*****************************************************************************
*   Copyright (c) DIDC, 1991, 1992.  All rights reserved.                   *
*   Unauthorized use, duplication, or distribution is strictly prohibited.  *
*****************************************************************************
}
{$F+}
Unit VISAGE;

(************************************************************************)
Interface
(************************************************************************)

Uses Dos,CRT;

function DIDC_locate_tsr : boolean;

function DIDC_total_pages(var dbname : string;
                          var kname : string) : integer;

function DIDC_total_pages_type(var dbname : string;
                               var kname : string;
                               doc_type : integer) : integer;

function DIDC_call_menu(var dbname : string;
                        var kname : string;
                        flag : integer;
                        var DocListFname : string) : Integer;

function DIDC_tsr_type : integer;

function DIDC_batch_update :  integer;

function DIDC_set_write_vol(wv : word) : integer;

function DIDC_clear_doc_page : integer;

function DIDC_unique_key(var dbfname : string;
                         var key : string;
                         len : integer) : integer;

function DIDC_get_write_vol : integer;

function DIDC_show_luns : integer;

function DIDC_scan_page(var dbname : string;
                        var kname : string;
                        page_type : integer) : Integer;

function DIDC_auto_scan(var dbname : string;
                        var kname : string;
                        page_type : integer) : Integer;

function DIDC_set_scanner(page_len : integer;
                          source : integer;
                          intensity : integer) : integer;

function DIDC_insert_page(var dbname : string;
                          var kname : string;
                          page_type : integer;
                          page_num  : integer) : Integer;

function DIDC_delete_page(var dbname : string;
                          var kname : string;
                          page_type : integer;
                          page_num  : integer) : Integer;

function DIDC_get_scanner(param : integer) : Integer;

function DIDC_save_scan_set : Integer;

function DIDC_print_all_pages_type(var dbname : string;
                                   var kname : string;
                                   doctype : integer) : integer;

function DIDC_print_pages(var dbname : string;
                          var kname : string;
                          doctype : integer;
                          first_page : integer;
                          last_page : integer) : integer;


function DIDC_display_page(var dbname : string;
                           var kname : string;
                           pagetype, page : integer;
                           control : integer) : Integer;

procedure checkkf9200;

(************************************************************************)
IMPLEMENTATION
(************************************************************************)

type
  stype = array[0..50] of char;

var
  DTIregs : Registers;
  res     : longint;
  DTIint  : word;
  params  : ^stype;
  strng : string;

const
  DTI_TIMEOUT : integer = -555;
  MAX_RETRY : integer = 10;

(************************************************************************)

function dti_done : boolean;
begin
if (params^[0] = chr(0)) then
  dti_done  := true
else
  dti_done  := false;
end;

(************************************************************************)

function DIDC_result : integer;
var
  i : integer;
begin
move(params^[1],i,2);
DIDC_result  := i;
end;

(************************************************************************)

procedure write_params(s : string);
var
  i : integer;
begin
for i  := 1 to length(s) do
  params^[i-1]  := upcase(s[i]);
params^[i]  := chr(0);
end;

(************************************************************************)

function DIDC_call_tsr(var s : string) : integer;
var
  retry : integer;
begin
if (DTIint = 0) then
  begin
  DIDC_call_tsr  := 0;
  exit;
  end;

for retry  := 1 to MAX_RETRY do
  begin
  DTIregs.ax  := 1;
  write_params(s);
  Intr(DTIint,DTIregs);
  delay(100);
  if dti_done then
    begin
    DIDC_call_tsr  := DIDC_result;
    exit;
    end;
  end;
DIDC_call_tsr  := DTI_TIMEOUT;
end;

(************************************************************************)

function hexval(c : char) : integer;
begin
  case upcase(c) of
  '0' : hexval  := 0;
  '1' : hexval  := 1;
  '2' : hexval  := 2;
  '3' : hexval  := 3;
  '4' : hexval  := 4;
  '5' : hexval  := 5;
  '6' : hexval  := 6;
  '7' : hexval  := 7;
  '8' : hexval  := 8;
  '9' : hexval  := 9;
  'A' : hexval  := 10;
  'B' : hexval  := 11;
  'C' : hexval  := 12;
  'D' : hexval  := 13;
  'E' : hexval  := 14;
  'F' : hexval  := 15;
  end;
end;

(************************************************************************)

function hexconv(s : string) : integer;
begin
hexconv  := hexval(s[1])*16 + hexval(s[2]);
end;

(************************************************************************)

function DIDC_locate_tsr : boolean;
type
  addr  = array[1..2] of word;
  aa_type = array[1..20] of char;
var
  a : ^addr;
  s,o : word;
  aa : ^aa_type;
  i,j : integer;
begin

for j  := $60 to $67 do
  begin
  {writeln(j);}
  a  := ptr(0,j*4);
  s  := a^[2];
  o  := a^[1];
  {writeln('s = ',s,' o = ',o);}

  if (s > 0) then
  for i  := 1 to 5 do
    begin
    aa  := ptr(s,o);
    if (aa^[1] = 'P') and
       (aa^[2] = 'Q') and
       (aa^[3] = 'R') and
       (aa^[4] = 'S') and
       (aa^[5] = 'T') and
       (aa^[6] = 'U') then
      begin
      DTIregs.ax  := 0;
      Intr(j,DTIregs);
      {
      writeln(DTIregs.cx,'  ',DTIregs.dx);
      readln;
      }
      params  := ptr(DTIregs.cx,DTIregs.dx);
      DIDC_locate_tsr  := true;
      DTIint  := j;
      exit;
      end;
    o  := o + 1;
    end;
  end;
DIDC_locate_tsr  := false;
DTIint  := 0;
end;

(************************************************************************)
(* General functions                                                    *)
(************************************************************************)

function DIDC_total_pages(var dbname : string;
                          var kname : string) : integer;
begin
(* function 001 *)
strng  := '1 '+dbname+' '+kname;
DIDC_total_pages  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_total_pages_type(var dbname : string;
                               var kname : string;
                               doc_type : integer) : integer;
var
  s : string[20];
begin
(* function 002 *)
str(doc_type,s);

strng  := '2 '+dbname+' '+kname+' '+s;
DIDC_total_pages_type  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_call_menu(var dbname : string;
                        var kname : string;
                        flag : integer;
                        var DocListFname : string) : Integer;
const
  NO_DB_NAME = -561;
  EMPTY_KEY  = -559;
var
  s : string[20];

Begin
(* function 003 *)


if (length(dbname) = 0) then
  begin
  DIDC_call_menu := NO_DB_NAME;
  exit;
  end;

if (length(kname) = 0) then
  begin
  DIDC_call_menu := EMPTY_KEY;
  exit;
  end;


str(flag,s);
strng  := '3 '+dbname+' '+kname+' '+s+' '+DocListFname;
DIDC_call_menu  := DIDC_call_tsr(strng);
End;

(************************************************************************)

function DIDC_tsr_type : integer;
begin
(* function 004 *)
strng  := '4';
DIDC_tsr_type  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_batch_update :  integer;
(* function 005 *)
begin
strng  := '5';
DIDC_batch_update  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_set_write_vol(wv : word) : integer;
(* function 006 *)
var
  s : string[30];
begin
str(wv,s);
strng  := '6 '+s;
write_params(strng);
DIDC_set_write_vol := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_clear_doc_page : integer;
(* function 007 *)
begin
strng  := '7';
DIDC_clear_doc_page  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_unique_key(var dbfname : string;
                         var key : string;
                         len : integer) : integer;
(* function 008 *)
var
  i,j : integer;
  c : char;
  s : string[20];
begin
str(len,s);
strng  := '8 '+dbfname+' '+s;
i  := DIDC_Call_Tsr(strng);


j  := 3;
if (i = 0) then
  begin
  move(params^[j],c,1);
  key  := '';
  while (c > #0) do
    begin
    key  := key + c;
    j  := j + 1;
    move(params^[j],c,1);
    end;
  end;

DIDC_Unique_Key  := i;
end;

(************************************************************************)

function DIDC_get_write_vol : integer;
begin
(* function 010 *)
strng  := '10';
DIDC_get_write_vol  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_show_luns : integer;
begin
(* function 011 *)
strng  := '11';
DIDC_show_luns := DIDC_call_tsr(strng);
end;

(************************************************************************)
(* Scan functions                                                       *)
(************************************************************************)

function DIDC_scan_page(var dbname : string;
                        var kname : string;
                        page_type : integer) : Integer;
var
 s : string[10];
Begin
str(page_type,s);
strng  := '101 '+dbname+' '+kname+' '+s;
DIDC_scan_page  := DIDC_call_tsr(strng);
End;

(************************************************************************)

function DIDC_auto_scan(var dbname : string;
                        var kname : string;
                        page_type : integer) : Integer;
var
 s : string[10];
Begin
str(page_type,s);
strng  := '102 '+dbname+' '+kname+' '+s;
DIDC_auto_scan  := DIDC_call_tsr(strng);
End;

(************************************************************************)

function DIDC_set_scanner(page_len : integer;
                          source : integer;
                          intensity : integer) : integer;
var
  s1,s2,s3 : string[20];
begin
(* function 103 *)
str(page_len,s1);
str(source,s2);
str(intensity,s3);
strng  := '103 '+s1+' '+s2+' '+s3;
DIDC_set_scanner := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_insert_page(var dbname : string;
                          var kname : string;
                          page_type : integer;
                          page_num  : integer) : Integer;
var
  s1,s2 : string[20];
begin
(* function 104 *)
str(page_type,s1);
str(page_num,s2);
strng  := '104 '+dbname+' '+kname+' '+s1+' '+s2;
DIDC_insert_page  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_delete_page(var dbname : string;
                          var kname : string;
                          page_type : integer;
                          page_num  : integer) : Integer;
var
  s1,s2 : string[20];
begin
(* function 105 *)
str(page_type,s1);
str(page_num,s2);
strng  := '105 '+dbname+' '+kname+' '+s1+' '+s2;
DIDC_delete_page  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_get_scanner(param : integer) : Integer;
var
  s1 : string[20];
begin
(* function 106 *)
str(param,s1);
strng  := '106 '+s1;
DIDC_get_scanner  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_save_scan_set : Integer;
begin
(* function 107 *)
strng  := '107';
DIDC_save_scan_set  := DIDC_call_tsr(strng);
end;


(************************************************************************)
(* Print functions                                                      *)
(************************************************************************)

function DIDC_print_all_pages_type(var dbname : string;
                                   var kname : string;
                                   doctype : integer) : integer;
var
  s1 : string[20];
begin
(* function 201 *)
str(doctype,s1);

strng  := '201 '+dbname+' '+kname+' '+s1;
DIDC_print_all_pages_type  := DIDC_call_tsr(strng);
end;

(************************************************************************)

function DIDC_print_pages(var dbname : string;
                          var kname : string;
                          doctype : integer;
                          first_page : integer;
                          last_page : integer) : integer;
var
  s1,s2,s3 : string[20];
begin
str(doctype,s1);
str(first_page,s2);
str(last_page,s3);

strng  := '203 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
DIDC_print_pages  := DIDC_call_tsr(strng);
end;

(************************************************************************)
(* Display Functions                                                    *)
(************************************************************************)

function DIDC_display_page(var dbname : string;
                           var kname : string;
                           pagetype, page : integer;
                           control : integer) : Integer;
var
  s1,s2,s3 : string[30];
(* function 300 *)
begin
str(pagetype,s1);
str(page,s2);
str(control,s3);

strng  := '300 '+dbname+' '+kname+' '+s1+' '+s2+' '+s3;
DIDC_display_page  := DIDC_call_tsr(strng);
end;

(************************************************************************)

procedure checkkf9200;
begin
if not DIDC_locate_tsr then
  begin
  writeln('VISAGE is not loaded.');
  writeln('You will not be able to access images...');
  readln;
  end;
end;

(************************************************************************)

begin
checkkf9200;
end.